home *** CD-ROM | disk | FTP | other *** search
/ Power Programmierung / Power-Programmierung (Tewi)(1994).iso / magazine / nan_news / toolkit / datecnfg.prg < prev    next >
Text File  |  1991-08-15  |  12KB  |  334 lines
  1. /*
  2.  * File......: DATECNFG.PRG
  3.  * Author....: Jo W. French dba Practical Computing
  4.  * CIS ID....: 74730,1751
  5.  * Date......: $Date:   15 Aug 1991 23:05:10  $
  6.  * Revision..: $Revision:   1.2  $
  7.  * Log file..: $Logfile:   E:/nanfor/src/datecnfg.prv  $
  8.  * 
  9.  * The functions contained herein are the original work of Jo W. French
  10.  * and are placed in the public domain.
  11.  *
  12.  * Modification history:
  13.  * ---------------------
  14.  *
  15.  * $Log:   E:/nanfor/src/datecnfg.prv  $
  16.  * 
  17.  *    Rev 1.2   15 Aug 1991 23:05:10   GLENN
  18.  * Forest Belt proofread/edited/cleaned up doc
  19.  * 
  20.  *    Rev 1.1   14 Jun 1991 19:51:26   GLENN
  21.  * Minor edit to file header
  22.  * 
  23.  *    Rev 1.0   01 Apr 1991 01:01:00   GLENN
  24.  * Nanforum Toolkit
  25.  *
  26.  */
  27.  
  28.  
  29. #ifdef FT_TEST
  30.   ********************************************************************
  31.   *
  32.   * NOTES: 1) The date functions are 'international'; i.e., the
  33.   *           system date format is maintained, although ANSI is
  34.   *           temporarily used within certain functions.
  35.   *
  36.   *        2) The date functions fall into two categories:
  37.   *
  38.   *           a) Calendar or fiscal periods.
  39.   *              A calendar or fiscal year is identified by the year()
  40.   *              of the last date in the year.
  41.   *
  42.   *           b) Accounting Periods. An accounting period has the
  43.   *              following characteristics:
  44.   *              If the first week of the period contains 4 or
  45.   *              more 'work' days, it is included in the period;
  46.   *              otherwise, the first week was included in the
  47.   *              prior period.
  48.   *
  49.   *              If the last week of the period contains 4 or more
  50.   *              'work' days it is included in the period; otherwise,
  51.   *              the last week is included in the next period.
  52.   *              This results in 13 week 'quarters' and 4 or 5 week
  53.   *              'months'. Every 5 or 6 years, a 'quarter' will contain
  54.   *              14 weeks and the year will contain 53 weeks.
  55.   *
  56.   *        3) The date functions require the presence of two variables:
  57.   *
  58.   *           a) cFY_Start is a character string used to define the
  59.   *              first day of a calendar or fiscal year. It's format
  60.   *              is ANSI; e.g., "1980.01.01" defines a calendar year,
  61.   *              "1980.10.01" defines a fiscal year, starting October 1.
  62.   *
  63.   *              The year may be any valid year. It's value has no
  64.   *              effect on the date functions. The day is assumed to be
  65.   *              less than 29. See function: FT_DATECNFG().
  66.   *
  67.   *           B) nDow_Start is a number from 1 to 7 which defines the
  68.   *              starting day, DOW(), of a work week; e.g., 1 == Sunday.
  69.   *
  70.   *              See function: FT_DATECNFG()
  71.   *
  72.   * COMPILE ALL PROGRAMS WITH /N /W /A
  73.   *
  74.   ********************************************************************
  75.  
  76.   FUNCTION DEMO()
  77.      LOCAL nNum, dDate, aTestData := {}, aTemp, cFY_Start, nDOW_Start
  78.  
  79. *    SET DATE American                         // User's normal date format
  80.      aTemp      := FT_DATECNFG()               // Get/Set cFY_Start & nDOW_Start.
  81. *    aTemp      := FT_DATECNFG("03/01/80", 1)  // Date string in user's format.
  82.      cFY_Start  := aTemp[1]                    // See FT_DATECNFG() in FT_DATE0.PRG
  83.      NDOW_START := ATEMP[2]                    // FOR PARAMETERS.
  84.      DDATE      := DATE()
  85. *    dDate      := CTOD("02/29/88")            // Test date, in user's normal date format
  86.  
  87.      cls
  88.      ?    "Given       Date:  "
  89.      ??   dDate
  90.      ??   " cFY_Start: "+ cFY_Start
  91.      ??   " nDOW_Start:" + STR(nDOW_Start,2)
  92.      ?    "---- Fiscal Year Data -----------"
  93.  
  94.      aTestData := FT_YEAR(dDate)
  95.      ? "FYYear     ", aTestData[1]+"  ", aTestData[2], aTestData[3]
  96.  
  97.      aTestData := FT_QTR(dDate)
  98.      ? "FYQtr      ", aTestData[1], aTestData[2], aTestData[3]
  99.  
  100.      nNum      := VAL(SUBSTR(aTestData[1],5,2))
  101.      aTestData := FT_QTR(dDate,nNum)
  102.      ? "FYQtr    "+STR(nNum,2), aTestData[1], aTestData[2], aTestData[3]
  103.  
  104.      aTestData := FT_MONTH(dDate)
  105.      ? "FYMonth    ", aTestData[1], aTestData[2], aTestData[3]
  106.  
  107.      nNum := VAL(SUBSTR(aTestData[1],5,2))
  108.      aTestData := FT_MONTH(dDate,nNum)
  109.      ? "FYMonth  "+STR(nNum,2), aTestData[1], aTestData[2], aTestData[3]
  110.  
  111.      aTestData := FT_WEEK(dDate)
  112.      ? "FYWeek     ", aTestData[1], aTestData[2], aTestData[3]
  113.  
  114.      nNum      := VAL(SUBSTR(aTestData[1],5,2))
  115.      aTestData := FT_WEEK(dDate,nNum)
  116.      ? "FYWeek   "+STR(nNum,2), aTestData[1], aTestData[2], aTestData[3]
  117.  
  118.      aTestData := FT_DAYOFYR(dDate)
  119.      ? "FYDay     ", aTestData[1], aTestData[2], aTestData[3]
  120.  
  121.      nNum      := VAL(SUBSTR(aTestData[1],5,3))
  122.      aTestData := FT_DAYOFYR(dDate,nNum)
  123.      ? "FYDAY   "+STR(nNum,3), aTestData[1], aTestData[2], aTestData[3]
  124.  
  125.      ?
  126.      ? "---- Accounting Year Data -------"
  127.  
  128.      aTestData := FT_ACCTYEAR(dDate)
  129.      ? "ACCTYear   ", aTestData[1]+"  ", aTestData[2], aTestData[3],;
  130.            STR( (aTestData[3] - aTestData[2] + 1) /7, 3 ) + " Weeks"
  131.  
  132.      aTestData := FT_ACCTQTR(dDate)
  133.      ? "ACCTQtr    ", aTestData[1], aTestData[2], aTestData[3],;
  134.         STR( (aTestData[3] - aTestData[2] + 1) /7, 3 ) + " Weeks"
  135.  
  136.      nNum      := VAL(SUBSTR(aTestData[1],5,2))
  137.      aTestData := FT_ACCTQTR(dDate,nNum)
  138.      ? "ACCTQtr  "+STR(nNum,2), aTestData[1], aTestData[2], aTestData[3]
  139.  
  140.      aTestData := FT_ACCTMONTH(dDate)
  141.      ? "ACCTMonth  ", aTestData[1], aTestData[2], aTestData[3],;
  142.         STR( (aTestData[3] - aTestData[2] + 1) /7, 3 ) + " Weeks"
  143.  
  144.      nNum      := VAL(SUBSTR(aTestData[1],5,2))
  145.      aTestData := FT_ACCTMONTH(dDate,nNum)
  146.      ? "ACCTMonth"+STR(nNum,2), aTestData[1], aTestData[2], aTestData[3]
  147.  
  148.      aTestData := FT_ACCTWEEK(dDate)
  149.      ? "ACCTWeek   ", aTestData[1], aTestData[2], aTestData[3]
  150.  
  151.      nNum      := VAL(SUBSTR(aTestData[1],5,2))
  152.      aTestData := FT_ACCTWEEK(dDate,nNum)
  153.      ? "ACCTWeek "+STR(nNum,2), aTestData[1], aTestData[2], aTestData[3]
  154.  
  155.      aTestData := FT_DAYOFYR(dDate,,.T.)
  156.      ? "ACCTDay   ", aTestData[1], aTestData[2], aTestData[3]
  157.  
  158.      nNum      := VAL(SUBSTR(aTestData[1],5,3))
  159.      aTestData := FT_DAYOFYR(dDate,nNum,.T.)
  160.      ? "ACCTDay "+STR(nNum,3), aTestData[1], aTestData[2], aTestData[3]
  161.  
  162.      WAIT
  163.  
  164.      FT_CAL(dDate)
  165.      FT_CAL(dDate,1)
  166.  
  167.   RETURN NIL
  168.  
  169.  
  170.   * DEMO Monthly Calendar function.
  171.   * nType : 0 = FT_MONTH, 1 = FT_ACCTMONTH
  172.   *
  173.  
  174.   FUNCTION FT_CAL(dGivenDate,nType)
  175.      LOCAL nTemp, dTemp, aTemp, cFY_Start, dStart, dEnd
  176.  
  177.      aTemp     := FT_DATECNFG()
  178.      cFY_Start := aTemp[1]
  179.  
  180.      IF dGivenDate == NIL .OR. !VALTYPE(dGivenDate) $ 'ND'
  181.         dGivenDate := DATE()
  182.      ELSEIF VALTYPE(dGivenDate) == 'N'
  183.         nType := dGivenDate
  184.         dGivenDate := DATE()
  185.      ENDIF
  186.  
  187.      nType := IF(nType == NIL .OR. VALTYPE(nType) != 'N', 0, nType)
  188.  
  189.      IF nType == 0
  190.         IF SUBSTR(cFY_Start,6,5) == "01.01"
  191.            ? "          Calendar Month Calendar containing " + DTOC(dGivenDate)
  192.         ELSE
  193.            ? "            Fiscal Month Calendar containing " + DTOC(dGivenDate)
  194.         ENDIF
  195.  
  196.         aTemp    := FT_MONTH(dGivenDate)
  197.         dStart   := aTemp[2]
  198.         dEnd     := aTemp[3]
  199.         aTemp[2] -= FT_DAYTOBOW(aTemp[2])
  200.         aTemp[3] += 6 - FT_DAYTOBOW(aTemp[3])
  201.      ELSE
  202.         ? "            Accounting Month Calendar containing " + DTOC(dGivenDate)
  203.         aTemp := FT_ACCTMONTH(dGivenDate)
  204.      ENDIF
  205.  
  206.   ?
  207.   dTemp := aTemp[2]
  208.  
  209.   FOR nTemp := 0 to 6
  210.      ?? PADC( CDOW(dTemp + nTemp),10)
  211.   NEXT
  212.  
  213.   ?
  214.   WHILE dTemp <= aTemp[3]
  215.      FOR nTemp = 1 TO 7
  216.         ?? " "
  217.         IF nType == 0 .AND. (dTemp < dStart .or. dTemp > dEnd)
  218.            ?? SPACE(8)
  219.         ELSE
  220.            ?? dTemp
  221.         ENDIF
  222.         ?? " "
  223.         dTemp ++
  224.      NEXT
  225.      ?
  226.   END
  227.  
  228.   RETURN NIL
  229.  
  230. #endif
  231.  
  232. /*  $DOC$
  233.  *  $FUNCNAME$
  234.  *     FT_DATECNFG()
  235.  *  $CATEGORY$
  236.  *     Date/Time
  237.  *  $ONELINER$
  238.  *     Set beginning of year/week for FT_ date functions
  239.  *  $SYNTAX$
  240.  *     FT_DATECNFG( [ <cFYStart> ], [ <nDow> ] ) -> aDateInfo
  241.  *  $ARGUMENTS$
  242.  *     <cFYStart> is a character date string in the user's system date
  243.  *     format, i.e., the same as the user would enter for CTOD().  If
  244.  *     this argument is NIL, the current value is unchanged.
  245.  *
  246.  *     Note: The year portion of the date string must be present and
  247.  *     be a valid year; however, it has no real meaning.
  248.  *
  249.  *     <nDow> is a number from 1 to 7 (1 = Sunday) indicating the
  250.  *     desired start of a work week.  If this argument is NIL,
  251.  *     the current value is unchanged.
  252.  *
  253.  *  $RETURNS$
  254.  *     A 2-element array containing the following information:
  255.  *
  256.  *        aDateInfo[1] - an ANSI date string indicating the beginning
  257.  *                       date of the year.  Only the month and day are
  258.  *                       meaningful.
  259.  *
  260.  *        aDateInfo[2] - the number of the first day of the week
  261.  *                       (1 = Sunday)
  262.  *
  263.  *  $DESCRIPTION$
  264.  *     FT_DATECNFG() is called internally by many of the date functions
  265.  *     in the library to determine the beginning of year date and
  266.  *     beginning of week day.
  267.  *
  268.  *     The default beginning of the year is January 1st and the default
  269.  *     beginning of the week is Sunday (day 1).  Either or both of these
  270.  *     settings may be changed by calling FT_DATECNFG() with the proper
  271.  *     arguments.  They will retain their values for the duration of the
  272.  *     program or until they are changed again by a subsequent call to
  273.  *     FT_DATECNFG().
  274.  *
  275.  *     It is not necessary to call FT_DATECNFG() unless you need to
  276.  *     change the defaults.
  277.  *
  278.  *     FT_DATECNFG() affects the following library functions:
  279.  *
  280.  *       FT_WEEK()       FT_ACCTWEEK()       FT_DAYTOBOW()
  281.  *       FT_MONTH()      FT_ACCTMONTH()      FT_DAYOFYR()
  282.  *       FT_QTR()        FT_ACCTQTR()        FT_ACCTADJ()
  283.  *       FT_YEAR()       FT_ACCTYEAR()
  284.  *  $EXAMPLES$
  285.  *       // Configure library date functions to begin year on
  286.  *       //  July 1st.
  287.  *
  288.  *       FT_DATECNFG("07/01/80")    // year is insignificant
  289.  *
  290.  *       // Examples of return values:
  291.  *
  292.  *       //  System date format: American           aArray[1]    aArray[2]
  293.  *
  294.  *       aArray := FT_DATECNFG()              //  '1980.01.01'     1 (Sun.)
  295.  *       aArray := FT_DATECNFG('07/01/80')    //  '1980.07.01'     1 (Sun.)
  296.  *       aArray := FT_DATECNFG('07/01/80', 2) //  '1980.07.01'     2 (Mon.)
  297.  *       aArray := FT_DATECNFG( , 2 )         //  '1980.01.01'     2 (Mon.)
  298.  *
  299.  *       //  System date format: British
  300.  *
  301.  *       aArray := FT_DATECNFG('01/07/80', 2) //  '1980.07.01'     2 (Mon.)
  302.  *  $SEEALSO$
  303.  *     FT_ACCTADJ()
  304.  *  $END$
  305. */
  306.  
  307. FUNCTION FT_DATECNFG( cFYStart ,nDow )
  308.  
  309.   STATIC aDatePar := { "1980.01.01", 1 }
  310.  
  311.   LOCAL dCheck, cDateFormat := SET(_SET_DATEFORMAT)
  312.  
  313.   IF VALTYPE( cFYStart ) == 'C'
  314.      dCheck := CTOD( cFYStart )
  315.      IF DTOC( dCheck ) != " "
  316.  
  317.         /* No one starts a Fiscal Year on 2/29 */
  318.         IF MONTH(dCheck) == 2 .and. DAY(dcheck) == 29
  319.            dCheck --
  320.         ENDIF
  321.  
  322.         SET(_SET_DATEFORMAT, "yyyy.mm.dd")
  323.         aDatePar[1] := DTOC(dCheck)
  324.         SET(_SET_DATEFORMAT, cDateFormat)
  325.      ENDIF
  326.   ENDIF
  327.  
  328.   IF VALTYPE( nDow ) == 'N' .AND. nDow > 0 .AND. nDow < 8
  329.      aDatePar[2] := nDow
  330.   ENDIF
  331.  
  332. RETURN ACLONE( aDatePar )
  333.  
  334.